Option Strict Off
Option Explicit On
Module mouse_flexgrid
	
	
	' declaraciones del api
	'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
	Private Declare Function SetWindowLong Lib "user32"  Alias "SetWindowLongA"(ByVal hwnd As Integer, ByVal nIndex As Integer, ByVal dwNewLong As Integer) As Integer
	
	Private Declare Function CallWindowProc Lib "user32"  Alias "CallWindowProcA"(ByVal lpPrevWndFunc As Integer, ByVal hwnd As Integer, ByVal Msg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
	
	Private Declare Function FindWindowEx Lib "user32"  Alias "FindWindowExA"(ByVal hWnd1 As Integer, ByVal hWnd2 As Integer, ByVal lpsz1 As String, ByVal lpsz2 As String) As Integer
	
	'UPGRADE_ISSUE: Declaring a parameter 'As Any' is not supported. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="FAE78A8D-8978-4FD4-8208-5B7324A8F795"'
	Private Declare Function SendMessage Lib "user32"  Alias "SendMessageA"(ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByRef lParam As Any) As Integer
	
	Private Declare Function GetClassName Lib "user32"  Alias "GetClassNameA"(ByVal hwnd As Integer, ByVal lpClassName As String, ByVal nMaxCount As Integer) As Integer
	
	
	'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
	
	' Constantes
	'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
	
	Private Const GWL_WNDPROC As Short = (-4)
	Private Const WM_MOUSEWHEEL As Integer = &H20A
	Private Const WM_VSCROLL As Short = &H115
	
	Dim PrevProc As Integer
	
	' instala el hook para el control indicado
	Public Sub IniciarScroll(ByRef ElControl As Object)
		'UPGRADE_WARNING: Add a delegate for AddressOf WindowProc Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="E9E157F7-EF0C-4016-87B7-7D7FBBC6EE08"'
		'UPGRADE_WARNING: Couldn't resolve default property of object ElControl.hwnd. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
		PrevProc = SetWindowLong(ElControl.hwnd, GWL_WNDPROC, AddressOf WindowProc)
	End Sub
	
	' Remueve el Hook para el control indicado
	Public Sub DetenerScroll(ByRef ElControl As Object)
		'UPGRADE_WARNING: Couldn't resolve default property of object ElControl.hwnd. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
		SetWindowLong(ElControl.hwnd, GWL_WNDPROC, PrevProc)
	End Sub
	
	' Procedimiento para procesar los mensajes de windows
	'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
	Public Function WindowProc(ByVal hwnd As Integer, ByVal uMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
		
		Dim HScroll As Integer
		
		
		' Obtiene el Hwnd de la barra de Scroll vertical del DataGrid
		HScroll = FindWindowEx(hwnd, 0, "ScrollBar", "DataGridSplitVScroll")
		
		If clase(hwnd) = "DataGridWndClass" And HScroll = 0 Then
			WindowProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam)
			Exit Function
		End If
		
		If uMsg = WM_MOUSEWHEEL Then
			
			If clase(hwnd) = "DataGridWndClass" And HScroll <> 0 Then
				
				If wParam < 0 Then
					' Scroll hacia abajo
					SendMessage(hwnd, WM_VSCROLL, 1, HScroll)
				Else
					' Mueve el scroll hacia arriba
					SendMessage(hwnd, WM_VSCROLL, 0, HScroll)
				End If
			Else
				If wParam < 0 Then
					' Scroll hacia abajo
					SendMessage(hwnd, WM_VSCROLL, 1, 0)
				Else
					' Mueve el scroll hacia arriba
					SendMessage(hwnd, WM_VSCROLL, 0, 0)
				End If
			End If
			
		End If
		
		WindowProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam)
		
	End Function
	
	Private Function clase(ByRef handle As Integer) As String
		Dim buffer As New VB6.FixedLengthString(256)
		Dim ret As Integer
		ret = GetClassName(handle, buffer.Value, 256)
		
		clase = Left(buffer.Value, ret)
	End Function
End Module